home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / info-service / gopher / Unix / gateways / gonnrp / gonnrp-2.2 < prev    next >
Encoding:
Text File  |  1993-06-08  |  9.0 KB  |  343 lines
  1. #!/bin/perl 
  2. # Gopher-nnrp Gateway
  3. # 08-Jun-1993 version 2.2 Chad Adams (c-adams@bgu.edu)
  4. # remove hardcoded paths and make -G with no param work
  5. #
  6. # 28-May-1993 version 2.1 Chad Adams (c-adams@bgu.edu)
  7. # build in access control for clari groups.  Make errors returned the same
  8. #   format as server errors so our version of gopher will put them in pop
  9. #   up box.
  10. #
  11. # 28-May-1993 version 2.0 Chad Adams (c-adams@bgu.edu)
  12. # major rewrite by: Chad Adams
  13. # add newgroups database.
  14. # add multi level newsgroup menus.  [each .part. of newsgroup automaticly
  15. #   gets it's own menu instead of putting all (like all of comp) in one
  16. #   menu.  {now menus like comp.sys, comp.lang, comp.sources, ect..}]
  17. # convert to use xhdr instead of tin's xindex.  If not used with INN using
  18. #   overview files to speed up xhdr it may be slow.
  19. #
  20. # Gopher-NNTP Gateway version 1.0
  21. # Author: Daniel Schales (dan@engr.latech.edu)
  22. # Major rewrite, socket support: Doug Schales (d1s8027@sc.tamu.edu)
  23. #
  24. # Set the 4 following variables for your setup. the 2 port variables
  25. # are set to the standard, be sure to set gopherhost and nntphost to
  26. # your respective hosts.
  27. $gopherhost="your.host.here";
  28. $gopherport=2008;
  29. $nntphost="your.host.here";
  30. $nntpprt='nntp';
  31.  
  32. $gonnrp = $0; # path to this script
  33. $newsdbm = '/usr/lib/newsgroups'; # where the newsgroups dbm files are
  34.  
  35. # localaddr for clari access.  Example:
  36. # @localaddr(143, 43, 139, 67);
  37. # allows access to 143.43.*.* and 139.67.*.*
  38. @localaddr = (143, 43, 139, 67);
  39.  
  40. @INC=("/usr/local/lib/perl");
  41. require 'sys/socket.ph';
  42. dump QUICKSTART if @ARGV[0] eq '-dump';
  43. QUICKSTART:
  44.  
  45. $SIG{'ALRM'} = 'stuck';
  46. $option=shift;
  47. $option = '-h' if $option eq '-t';
  48. while ($option eq '-f') {
  49.       $copyright = shift;
  50.       $option = shift;
  51.       open(CR, $copyright);
  52.       $title = <CR>;
  53.       close(CR);
  54.       chop($title);
  55.       print "0$title\t$copyright\t$gopherhost\t$gopherport\r\n";
  56. }
  57. $item=shift;
  58. if ($option eq '-X') {
  59.     @arts = @ARGV;
  60. } else {
  61.     $lookup=shift;
  62. }
  63. if (-S STDIN && ($item =~ m/^clari/)) {
  64.     $sockaddr = 'S n a4 x8';
  65.     ($fam, $proto, $addr) = unpack($sockaddr,getpeername(STDIN));
  66.     @inetaddr = unpack('C4',$addr);
  67.     for ($i = 0; $i < $#localaddr; $i += 2) {
  68.         $validaccess = 1 if @localaddr[$i] == @inetaddr[0] &&
  69.             @localaddr[$i+1] == @inetaddr[1];
  70.     }
  71.     $_ = 'Off site access not allowed to clari newsgroups  ';
  72.     &checkcode($validaccess,1);
  73. }
  74.  
  75. # set an alarm 5 minutes from now, if it goes off we must be stuck
  76. alarm(300);
  77. open(LOG,">>/tmp/nntplog");
  78. $date=`date`;chop($date);
  79. print LOG $date," ",$option," ",$item," ",$lookup,"\n";
  80. close(LOG);
  81. $sockaddr = 'S n a4 x8';
  82. ($name, $aliases, $proto) = getprotobyname('tcp');
  83. ($name, $aliases, $nntpport) = getservbyname($nntpprt, 'tcp');
  84. ($name, $aliases, $type, $len, $nntpaddr) = gethostbyname($nntphost);
  85.  
  86. $rsockaddr = pack($sockaddr, &AF_INET, $nntpport, $nntpaddr);
  87.  
  88. socket(NNTPSOCK, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  89. connect(NNTPSOCK, $rsockaddr) || die "connect: $!";
  90.  
  91. select(NNTPSOCK); $|= 1; select(stdout);
  92.  
  93. $_ = <NNTPSOCK>;
  94.  
  95. if ($option eq '-g') {
  96.     dbmopen(newsgroups, $newsdbm, 0444);
  97.     print NNTPSOCK "LIST\n";
  98.     $_ = <NNTPSOCK>;
  99.     chop; chop;
  100.     while($_ ne "."){
  101.     if($_ =~ "^$item"){
  102.         ($group) = split;
  103.         push(@out,"1$group - $newsgroups{$group}\texec:-h $group:".
  104.             "$gonnrp\t$gopherhost\t$gopherport\r\n");
  105.     }
  106.     $_ = <NNTPSOCK>;
  107.     chop; chop;
  108.     }
  109.     print sort(@out);
  110.     print ".\r\n";
  111. } elsif ($option eq '-G') {
  112.     dbmopen(newsgroups, $newsdbm, 0444);
  113.     print NNTPSOCK "LIST\n";
  114.     $_ = <NNTPSOCK>;
  115.     chop; chop;
  116.     if ($item ne '') {
  117.     $itemlen = length($item) + 1;
  118.     $dot = '.';
  119.     } else {
  120.     $itemlen = 0;
  121.     $dot = '';
  122.     }
  123.     @grouplist = ();
  124.     while($_ ne "."){
  125.     if($_ =~ "^$item"){
  126.             ($group) = split;
  127.         push(@grouplist, $group);
  128.     }
  129.         $_ = <NNTPSOCK>;
  130.         chop; chop;
  131.     }
  132.     @grouplist = sort(@grouplist);
  133.     for ($i = 0; $i <= $#grouplist; $i++) {
  134.         $group = @grouplist[$i];
  135.         if ($group eq $item) {
  136.         $grp = $group;
  137.             print "1$newsgroups{$group}\texec:-T $group:".
  138.             "$gonnrp\t$gopherhost\t$gopherport\r\n";
  139.         } else {
  140.         $grp = substr($group,$itemlen,40);
  141.         if (index($grp,'.') != -1) {
  142.             @grppart = split(/\./,$grp);
  143.             if (@grppart[0] eq $oldgrp) {
  144.             next;
  145.             }
  146.             $oldgrp = @grppart[0];
  147.             $grp = @grppart[0];
  148.                 print "1$grp - ".$newsgroups{"$item$dot$grp.all"}.
  149.             "\texec:-G $item$dot$grp".
  150.             ":$gonnrp\t$gopherhost\t$gopherport\r\n";
  151.         } else {
  152.             if ($group eq substr(@grouplist[$i+1],0,length($group))) {
  153.                     print "1$grp - ".$newsgroups{"$item$dot$grp.all"}.
  154.                 "\texec:-G $group:".
  155.                 "$gonnrp\t$gopherhost\t$gopherport\r\n";
  156.             $oldgrp = $grp;
  157.             } else {
  158.                     print "1$grp - $newsgroups{$group}\texec:-T $group:".
  159.                 "$gonnrp\t$gopherhost\t$gopherport\r\n";
  160.             }
  161.         }
  162.         }
  163.     }
  164.     print ".\r\n";
  165. } elsif($option eq '-X') {
  166. #    $item = newsgroup
  167. #    @arts = articles in this thread
  168. #      or
  169. #    @arts = 0 low high  if list would be too long
  170.     ($code) = &group($item);
  171.     # build arts array if we were passed range
  172.     @arts = split(' ', &buildidx(@arts[1], @arts[2])) if @arts[0] == 0;
  173.     foreach $art (@arts) { $goodart{$art} = 1; }
  174.     &xhdr('from', @arts[0], @arts[$#arts]);
  175.     while (<NNTPSOCK>) {
  176.         last if substr($_,0,1) eq '.';
  177.         chop; chop;
  178.         ($art, $from) = split(/ /,$_,2);
  179.         print "0$from\texec:-a ${item} $art:$gonnrp\t".
  180.             "$gopherhost\t$gopherport\r\n" if $goodart{$art};
  181.     }
  182.     print ".\r\n";
  183. } elsif($option eq '-T') {
  184.     ($code, $cnt, $low, $high) = &group($item);
  185.     &buildidx($low, $high);
  186.     @keys = sort(keys %idx);
  187.     foreach $key (@keys) {
  188.         @arts = split(' ',$idx{$key});
  189.         if ($#arts == 0) { # single article
  190.             print "0$key\texec:-a ${item} @arts[0]:".
  191.               "$gonnrp\t$gopherhost\t$gopherport\r\n";
  192.         } else { # thread
  193.             if (length($idx{$key}) < 80) { # send article list
  194.                 print "1$key\texec:-X $item$idx{$key}:".
  195.                   "$gonnrp\t$gopherhost\t$gopherport\r\n";
  196.             } else { # give range
  197.                 print "1$key\texec:".
  198.                   "-X $item 0 @arts[0] @arts[$#arts]:".
  199.                   "$gonnrp\t$gopherhost\t$gopherport\r\n";
  200.             }
  201.         }
  202.     }
  203.     print ".\r\n";
  204. } elsif($option eq '-l'){
  205.     ($code, $count, $start, $end) = &group($item);
  206.     if($count ne "0"){
  207.         print NNTPSOCK "ARTICLE $end\n";
  208.         $body=0;
  209.         $_ = <NNTPSOCK>;
  210.         chop; chop;
  211.         while($_ ne "."){
  212.             if ($body) {
  213.                 print "$_\r\n";
  214.             } elsif ($_ =~ "^220 " || $_ =~ "^222 ") {
  215.                 $body = 1;
  216.             }
  217.         }
  218.              $_ = <NNTPSOCK>;
  219.              chop; chop;
  220.      }
  221. }
  222. # rwp 20Aug92 Add ability to fetch last article.
  223.  
  224. elsif($option eq '-h' || $option eq '-b' || $option eq '-s'){
  225.     ($code, $count, $start, $end) = &group($item);
  226.     if($count ne "0"){
  227.         &xhdr('subject', $start, $end);
  228.         $_ = <NNTPSOCK>;
  229.         chop; chop;
  230.         while($_ ne '.'){
  231.             ($num,$desc) = split (/ /,$_,2);
  232.             if ($option eq '-h' ) {
  233.                 print "0$desc\texec:-a ${item} ${num}:".
  234.                   "$gonnrp\t$gopherhost\t$gopherport\r\n";
  235.             } elsif ($option eq '-b') {
  236.                 print "0$desc\texec:-a ${item} ${num} body".
  237.                   ":$gonnrp\t$gopherhost\t$gopherport\r\n";
  238.             } elsif ($option eq '-s') {
  239.                 $desc1="\L$desc\E";
  240.                 $lookup1 ="\L$lookup\E";
  241.                 if ($desc1 =~ $lookup1 ) {
  242.                  print "0$desc\texec:-a ${item} ${num}:".
  243.                   "$gonnrp\t$gopherhost\t$gopherport\t\r\n";
  244.                 }
  245.             }
  246.             $_ = <NNTPSOCK>;
  247.             chop; chop;
  248.         }
  249.     }
  250.     print ".\r\n";
  251. } elsif($option eq '-a'){
  252.     $num = $lookup;
  253.     $part = shift;
  254.     ($code) = &group($item);
  255.     if($part eq "body") {
  256.         print NNTPSOCK "BODY $num\n";
  257.         ($code) = split(/ /,($_ = <NNTPSOCK>));
  258.         &checkcode($code,222);
  259.     } else {
  260.         print NNTPSOCK "ARTICLE $num\n";
  261.         ($code) = split(/ /,($_ = <NNTPSOCK>));
  262.         &checkcode($code,220);
  263.     }
  264.     $_ = <NNTPSOCK>;
  265.     chop; chop;
  266.     while($_ ne "."){
  267.         print "$_\r\n";
  268.         $_ = <NNTPSOCK>;
  269.         chop; chop;
  270.     }
  271. }
  272.  
  273. print NNTPSOCK "QUIT\n";
  274. shutdown(NNTPSOCK, 2);
  275. exit(0);
  276.  
  277. sub stuck {
  278. open(LOG,">>/tmp/nntplog");
  279. $date=`date`;chop($date);
  280. print LOG $date," hung on ",$option," ",$item," ",$lookup,"\n";
  281. close(LOG);
  282.  
  283. exit;
  284. }
  285.  
  286. # Chad Adams  28-May-1993  tin's xindex to xhdr conversion
  287. sub checkcode { # return error when nntp command failes
  288.     local($code, $goodcode) = @_;
  289.     if ($code != $goodcode) {
  290.         chop; chop;
  291.         print "0nnrp error: $_\t\terror.host\t1\r\n";
  292.         print ".\r\n";
  293.         exit;
  294.     }
  295. }
  296. sub buildidx {    # build subject threads
  297.     local ($low, $high) = @_;
  298.     local ($first, $fsubj, $re, $subj);
  299.     $first = 1;
  300.     &xhdr('subject', $low, $high);
  301.     $cnt = 0;
  302.     while (<NNTPSOCK>) {
  303.         last if substr($_,0,1) eq '.';
  304.         chop; chop;
  305.         ($art, $subj) = split(/ /,$_,2);
  306.         while (1) { # remove Re:
  307.             $re = substr($subj,0,2);
  308.             $re =~ tr/A-Z/a-z/;
  309.             if ($re eq 're') {
  310.                 $subj = substr($subj,2);
  311.                 next;
  312.             } elsif (substr($subj,0,1) eq ':') {
  313.                 $subj = substr($subj,1);
  314.                 next;
  315.             } elsif (substr($subj,0,1) eq ' ') {
  316.                 $subj = substr($subj,1);
  317.                 next;
  318.             }
  319.             last;
  320.         }
  321.         if ($first) {
  322.             $fsubj = $subj;
  323.             $first = 0;
  324.         }
  325.         $idx{$subj} .= " $art";
  326.         $cnt++;
  327.     }
  328.     return $idx{$fsubj};
  329. }
  330. sub group { # (code, count, low, high) = &group(newsgroup)
  331.     local(@rtn);
  332.     print NNTPSOCK "group @_[0]\n";
  333.     @rtn = split(/ /,($_ = <NNTPSOCK>), 5);
  334.     &checkcode(@rtn[0],211);
  335.     return @rtn;
  336. }
  337. sub xhdr { # &xhdr(header,low,high)
  338.     local($code);
  339.     print NNTPSOCK "xhdr @_[0] ".@_[1].'-'.@_[2]."\n";
  340.     ($code) = split(/ /,($_ = <NNTPSOCK>));
  341.     &checkcode($code,221);
  342. }
  343.